Dataset Preparation Notes
summary.raw <- read.xlsx(xlsxFile = glue('{params$data_dir}/{params$summary_data_file}'),
sheet = 'Survey Data',
colNames = FALSE,
skipEmptyCols = FALSE,
na.strings = c("NA", "Suppressed", ""),
fillMergedCells = TRUE)
# get good column names we can use
colnames(summary.raw) <- gsub('(%)', '', summary.raw[2, ], fixed = T) %>%
trimws() %>%
make.names(unique = T)
# hold onto "row" metadata, this is the communities/names
survey.col.meta <- summary.raw[1, , drop = F] %>%
t() %>% as.data.frame() %>%
rownames_to_column("Name") %>%
rename(Area = `1`)
# drop the old rows we used to make column names and index the metadata
summary.raw <- summary.raw[-(1:2), ]
# keep the first two columns when we sort out the part of the health data we want (LHA)
keep <- list("Domain" = 1, "Indicator" = 2)
# subset to the LHA columns
summary.lha <- summary.raw[, c(unlist(keep),
which(survey.col.meta$Area == "Sub Regions"))]
# match the LHA IDs for use with map regions
id_lookup <- read.xlsx(xlsxFile = glue('{params$data_dir}/{params$data_dictionary_file}'),
sheet = 'CHSA_LHA_HSDA_HA_lookup',
colNames = TRUE,
na.strings = c("NA", "Suppressed", ""),
fillMergedCells = TRUE) %>%
select(LHA, LHA_Name) %>%
mutate(LHA_Name = make.names(LHA_Name, unique = T))
# raw data
data <- summary.lha[, -unlist(keep)] %>% t() %>% as.data.frame()
colnames(data) <- make.names(colnames(data), unique = T)
# column/sample (location) annotations
smp.ann <- summary.lha[, names(keep)]
rownames(smp.ann) <- colnames(data)
# row/variable (indication) annotations
var.ann <- data.frame("LHA_Name" = rownames(data), stringsAsFactors = F) %>%
left_join(id_lookup, by = "LHA_Name")
rownames(var.ann) <- var.ann$LHA_Name
var.ann <- var.ann %>% select(LHA)
#cleanup unused variables
# rm(summary.raw, survey.col.meta, id_lookup, keep, summary.lha)
GEO Data Notes Preparation Notes
Map boundary data was obtained from: https://www2.gov.bc.ca/gov/content/data/geographic-data-services/land-use/administrative-boundaries/health-boundaries
Data was downsampled to 1% of original using http://mapshaper.org
# lat/long geojson
boundaries.lha <- read_json(glue('{params$data_dir}/{params$lha_boundaries_file}'))
# chart tooltip events
lha.events <- JS("{
'mousemove' : function(o, e, t) {
console.log(t);
}}")
# get the row and column names from the geojson
# (so the map can match the values up to sections)
ids <- boundaries.lha$features %>%
lapply(function(x) { list(x[["properties"]]$LOCAL_HLTH_AREA_CODE,
x[["properties"]]$OBJECTID) })
ids <- as.data.frame(matrix(unlist(ids), ncol = 2, byrow = T), stringsAsFactors = F) %>%
rename(LOCAL_HLTH_AREA_CODE = 1, OBJECTID = 2)
rownames(data) <- var.ann$LHA
data <- data[match(ids$LOCAL_HLTH_AREA_CODE, rownames(data)), ]
canvasXpress(
data = data,
# data = FALSE,
graphType = "Map",
title = "Local Health Authorities (LHA)",
showLegend = FALSE,
topoJSON = boundaries.lha,
colorBy = "HLTH_AUTHORITY_NAME",
events = NULL #lha.events
)